home *** CD-ROM | disk | FTP | other *** search
Text File | 1996-03-06 | 18.8 KB | 627 lines | [TEXT/ALFA] |
- #=======================================================================
- # F2C.TCL supports MAC F2C and CODE WARRIOR
- #=======================================================================
- # 1.0b1 jul 95
- # 1.0b2 jul 95 listpick with -L blah as default, in the hope that blah
- # is no listelement. -L {} selects always the first
- # listelement.
- # 1.0b3 Dec 95 changes for CW IDE, some more comments
- # 1.0b4 Mar 96 added timeout option to AEBuild commands with replies
- #
- # Questions, comments, and bug reports to:
- # Klaus Thermann
- # klaus@gaga.maschinenbau.uni-dortmund.de
- # Thanks to
- # Dirk Froehling for lots of help with the Mac OS,
- # Igor Mikolic-Torreira for making MAC F2C available.
- #
- # Usage
- # • To see how it works
- # Bring this file to the front, load it by cmd L, and play around
- # • For permanent usage
- # Put it into the "Tcl:UserCode" folder of Alpha
- # Edit Prefs.tcl and add the line
- # source "$HOME:Tcl:UserCode:f2c.tcl"
-
- #
- # Menu procedures
- #
- # Translate F To C
- # Translates frontmost window from f to c using current
- # settings of MAC F2C, does nothing if frontmost window
- # is not *.f. If the window is dirty, it is saved before
- # translation.
- #
- # Open Project Closes current project, offers file dialog to select a
- # project and tells codewarrior to open it. The name of
- # the selected project appears as (always) deactived menu
- # item. Builds the list and menu items projectFiles and
- # otherFiles (see below)
- #
- # Get Project Assumes that a code warrior project is open and gets
- # its name and files. If no project exists: file dialog
- # as above
- #
- # Switch To Project
- # Select project from list. The list f2cProjects is saved
- # between sessions (addDef) and extended when a project is
- # opened not contained in the list.
- # Remove From List ... offers a dialog to remove files
- # from f2cProjects.
- #
- # Project Files Is a list of *.f files in the project folder which
- # have corresponding *.c files in the codewarrior project.
- # These files are edited (or simply brought to the front)
- # when selected.
- #
- # Other Files Is a (possibly empty) list of *.f files in the project
- # folder having no *.c counterparts in the project.
- # Editing as above.
- #
- # Run Saves all modified files and translates from f to c,
- # followed by CODE WARRIOR run.
- # When f2c detects an error the process is stopped and the
- # *.f file, where the error was detected, brought to front.
- #
- # Make Saves all modified files and translates from f to c,
- # followed by CODE WARRIOR make.
- # When f2c detects an error the process is stopped and the
- # *.f file, where the error was detected, brought to front.
- #
- # Add File The *.c file corresponding to the frontmost *.f file is
- # added to the project (if the *.c and *.f are in the
- # project folder, returns otherwise)
- #
- # Remove File The *.c file corresponding to the frontmost *.f file is
- # removed from the project (if the *.c and *.f are in the
- # project folder, returns otherwise).
- #
- # F to C & Add Files...
- # Offers a dialog to pick files from list otherFiles.
- # The selected files are translated from f to c and added
- # to the cw project.
- # When f2c detects an error the process is stopped and the
- # *.f file, where the error was detected, brought to front.
- #
- # Remove Files...
- # Offers a dialog to pick files from list projectFiles.
- # The selected files are removed from the cw project.
- #
-
- # We want CodeWarrior's IDE, but alphabits.tcl sets the
- # 68k C version (set cwSig MMCC).
- set cwSig CWIE
-
- # Define CodeWarrior event class (same as in codewarrior.tcl)
- set CWCLASS MMPR
-
- # Use "F2C" as menu title
- set f2cMenu F2C
- # To use the Mac F2C icon as title for the F2C menu, copy it
- # from Mac F2C to Alpha with ResEdit, replace "134" in the next
- # line with the icon ID and uncomment the line
- # set f2cMenu •134
-
- menu -n "$f2cMenu" -p f2cMenuProc {
- /K<UtranslateFToC
- (-
- openProject
- getProject
- {menu -n switchToProject -p f2cSwitchToProject {}}
- (-
- /R<Urun
- /M<Umake
- (-
- <SfToC&AddFiles…
- <SaddFile
- <S<EremoveFiles…
- <SremoveFile
- (-
- {menu -n otherFiles -p f2cOtherFilesProc {}}
- {menu -n projectFiles -p f2cProjectFilesProc {}}
- (-
- }
- enableMenuItem "$f2cMenu" run off
- enableMenuItem "$f2cMenu" make off
- enableMenuItem "$f2cMenu" AddFile off
- enableMenuItem "$f2cMenu" RemoveFile off
- enableMenuItem "$f2cMenu" otherFiles off
- enableMenuItem "$f2cMenu" projectFiles off
- enableMenuItem "$f2cMenu" fToC&AddFiles… off
- enableMenuItem "$f2cMenu" removeFiles… off
-
- # Build the project switch list
- addMenuItem switchToProject "removeFromList…"
- enableMenuItem switchToProject removeFromList off
- addMenuItem switchToProject (-
- if {[info exists f2cProjects]} {
- foreach item $f2cProjects {
- addMenuItem -m switchToProject [file tail $item]
- }
- enableMenuItem switchToProject removeFromList on
- }
-
- # Tell alpha that f2cMenu is a new mode menu
- append allModeMenus { f2cMenu }
- set modeMenus(Fort) { f2cMenu }
- # or insert permanently
- # insertMenu "$f2cMenu"
-
-
- #-----------------------------------------------------------------------
- # f2cMenu
- #-----------------------------------------------------------------------
- proc f2cMenu {} {}
-
- #-----------------------------------------------------------------------
- # f2cMenuProc
- #-----------------------------------------------------------------------
- proc f2cMenuProc {menu item} {
- if {$item == "openProject"} {
- f2cOpenOrGet open
- } elseif {$item == "getProject"} {
- f2cOpenOrGet get
- } elseif {$item == "translateFToC"} {
- f2cTranslateFToC
- } elseif {$item == "run"} {
- f2cRun
- } elseif {$item == "make"} {
- f2cMake
- } elseif {$item == "addFile"} {
- f2cAddFile
- } elseif {$item == "fToC&AddFiles"} {
- f2c&AddFiles
- } elseif {$item == "removeFile"} {
- f2cRemoveFile
- } elseif {$item == "removeFiles"} {
- f2cRemoveFiles
- } else {
- f2cEdit $item
- }
- }
-
- #-----------------------------------------------------------------------
- # f2cSwitchToProject
- #-----------------------------------------------------------------------
- proc f2cSwitchToProject {menu item} {
- global CODEWarrior CWCLASS
- global f2cProjects project projectdir projecttail oldProject
-
- if {$item == "removeFromList"} {
- set name [listpick -l -L blah -p "Pick project to remove from switch list:" $f2cProjects]
- if {[info exists f2cProjects]} {
- foreach item $name {
- deleteMenuItem -m switchToProject [file tail $item]
- if {[set i [lsearch -exact $f2cProjects "$item"]] >= 0} {
- set f2cProjects [lreplace $f2cProjects $i $i]
- }
- }
- addDef f2cProjects $f2cProjects
- }
- enableMenuItem switchToProject $projecttail
-
- } else {
- if {[set i [lsearch $f2cProjects "*$item"]] >=0 } {
- set newproject [lindex $f2cProjects $i]
- } else {
- alertnote "Project $item not found"
- return
- }
- f2cClean
- set project $newproject
- set projectdir [file dirname $project]
- set projecttail [file tail $project]
- f2cCheckCw
- AEBuild -t 500000 -r $CODEWarrior $CWCLASS ClsP]
- AEBuild $CODEWarrior aevt odoc "----" [makeAlis $project]
- f2cUpdate
- }
- }
-
- #-----------------------------------------------------------------------
- # f2cClean
- #-----------------------------------------------------------------------
- proc f2cClean {} {
- global f2cMenu otherFiles project oldProject projectFiles
-
- # remember old project
- if {[info exists project]} {
- set blah [file tail $project]
- catch {deleteMenuItem -m $f2cMenu "$blah"}
- set oldProject $project
- }
-
- # remove project files
- if {[info exists projectFiles]} {
- foreach item $projectFiles {catch {deleteMenuItem -m projectFiles $item}}
- set projectFiles {}
- }
-
- # remove other files
- if {[info exists otherFiles]} {
- foreach item $otherFiles {catch {deleteMenuItem -m otherFiles $item}}
- set otherFiles {}
- }
- }
-
- #-----------------------------------------------------------------------
- # f2cUpdate
- #-----------------------------------------------------------------------
- proc f2cUpdate {} {
- global f2cJobs f2cMenu otherFiles projectdir projecttail
- global CODEWarrior CWCLASS oldProject projectFiles
-
- # Enable old and disable new project in switch list
- if {[info exists oldProject]} {
- enableMenuItem switchToProject [file tail $oldProject] on
- }
- enableMenuItem switchToProject $projecttail off
-
- # Clean the list of files to be f2c'ed
- set f2cJobs {}
-
- # Show current project in menu
- addMenuItem -m $f2cMenu "($projecttail"
-
- # If a *.f file in the project directory has a corresponding *.c file
- # in the CodeWarrior project append it to the list projectFiles else to the
- # list otherFiles
- foreach f [glob $projectdir:*.f] {
- regsub {\.f$} $f {.c} cfile
- set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS FInP "----" [makeAlis $cfile]]
- regexp {:\[(.*)\]} $res dummy err
- if {! $err} {
- lappend projectFiles [file tail $f]
- } else {
- lappend otherFiles [file tail $f]
- }
- }
-
- # Update menu of project files
- if {[info exists projectFiles]} {
- foreach item $projectFiles { addMenuItem -m projectFiles $item }
- }
-
- # Update menu of other files
- if {[info exists otherFiles]} {
- foreach item $otherFiles { addMenuItem -m otherFiles $item }
- }
-
- # Update f2cMenu
- enableMenuItem "$f2cMenu" run on
- enableMenuItem "$f2cMenu" make on
- enableMenuItem "$f2cMenu" addFile on
- enableMenuItem "$f2cMenu" fToC&AddFiles… on
- enableMenuItem "$f2cMenu" removeFile on
- enableMenuItem "$f2cMenu" removeFiles… on
- enableMenuItem "$f2cMenu" otherFiles on
- enableMenuItem "$f2cMenu" projectFiles on
- }
-
- #-----------------------------------------------------------------------
- # f2cOpenOrGet: get open CodeWarrior project or
- # close project and open with standard file dialog
- #-----------------------------------------------------------------------
- proc f2cOpenOrGet {job} {
- global CODEWarrior CWCLASS f2cProjects project projectdir projecttail
-
- f2cClean
-
- # Open or get CodeWarrior project
- f2cCheckCw
- if {$job == "open"} {
- # Close current project, select new project, codewarrior open
- AEBuild -t 500000 -r $CODEWarrior $CWCLASS ClsP
- set project [getfile "Select CodeWarrior Project"]
- AEBuild $CODEWarrior aevt odoc "----" [makeAlis $project]
- } else {
- # Get name of open cw project
- set project [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GetP]
- regexp {«(.*)»} $project dummy spec
- set project [specToPathName $spec]
- if {$project == ""} {
- set project [getfile "Select Code Warrior Project"]
- AEBuild $CODEWarrior aevt odoc "----" [makeAlis $project]
- }
- }
- set projectdir [file dirname $project]
- set projecttail [file tail $project]
-
- # update f2cprojects
- if {[info exists f2cProjects]} {
- # check wether project in f2cprojects
- if {[lsearch -exact $f2cProjects $project] == -1} {
- # no, update
- lappend f2cProjects $project
- addDef f2cProjects $f2cProjects
- addMenuItem -m switchToProject $projecttail
- }
- } else {
- # f2cProjects still undefined, define
- lappend f2cProjects $project
- addDef f2cProjects $f2cProjects
- addMenuItem -m switchToProject $projecttail
- }
-
- f2cUpdate
- }
-
- #-----------------------------------------------------------------------
- # f2cEdit: edit or bring to front
- #-----------------------------------------------------------------------
- proc f2cEdit {item} {
- global projectdir
-
- # bring to front if file is open, otherwise edit
- if {[catch {bringToFront $item}]} {edit $projectdir:$item}
- }
-
- proc f2cOtherFilesProc {menu item} {f2cEdit $item}
- proc f2cProjectFilesProc {menu item} {f2cEdit $item}
-
- #-----------------------------------------------------------------------
- # f2cCheck: check wether MAC F2C is running, launch it if not
- #-----------------------------------------------------------------------
- proc f2cCheck {} {
- global MACF2C
- set MACF2C [checkRunning "Mac F2C" F2Ci f2cpath]
- }
-
- #-----------------------------------------------------------------------
- # f2cTranslateFToC: translate file in the frontmost window from f to c
- #-----------------------------------------------------------------------
- proc f2cTranslateFToC {} {
-
- global ALPHA MACF2C res f2cMenu
- # get name of frontmost window
- set fname [lindex [winNames -f] 0]
- # return if not *.f
- if {[regexp {.f$} $fname] == 0} return
- # save if window dirty
- getWinInfo win
- if {$win(dirty)} {save}
- # compile
- f2cCheck
- switchTo $MACF2C
- f2cOneFile $fname
- switchTo $ALPHA
- }
-
- #-----------------------------------------------------------------------
- # f2cOneFile: translate a single file from f to c
- #-----------------------------------------------------------------------
- proc f2cOneFile {fname} {
- global f2cJobs f2cMenu MACF2C ALPHA
-
- set res [AEBuild -t 500000 -r $MACF2C F2Ci F2C1 "----" [makeAlis $fname]]
- regexp {:\[(.*)\]} $res dummy err
- if {! $err} {
- # f2c sucessful, remove file from f2cJobs
- set i [lsearch -exact $f2cJobs $fname]
- if {$i >= 0} {set f2cJobs [lreplace $f2cJobs $i $i]}
- return 0
- } else {
- switchTo $ALPHA
- # set item to fname without path
- regexp {[^:]*$} $fname item
- f2cEdit $item
- return 1
- }
- }
-
- #-----------------------------------------------------------------------
- # f2cAddFile: add file in the front window to project
- #-----------------------------------------------------------------------
- proc f2cAddFile {} {
- global CODEWarrior CWCLASS projectdir f2cMenu projectFiles otherFiles
-
- # get name of current window
- set fname [lindex [winNames -f] 0]
-
- # return if not *.f
- if {[regexp {.f$} $fname] == 0} return
-
- # return if not in projectdir
- set blah [file tail $fname]
- set fname $projectdir:$blah
- if {[file exists $fname] != 1} return
-
- # return if *.c file not in projectdir
- regsub {\.f$} $fname {.c} cname
- if {[file exists $cname] != 1} return
-
- # ok, add to project and update menu
- f2cAddOneFile $cname
- }
-
- #-----------------------------------------------------------------------
- # f2cAddFiles
- #-----------------------------------------------------------------------
- proc f2c&AddFiles {} {
- global otherFiles projectFiles projectdir MACF2C ALPHA
- set name [listpick -l -L blah -p "Pick files to add to project:" $otherFiles]
- saveAll
- foreach item $name {
- regsub {\.f$} $item {.c} citem
- set cname $projectdir:$citem
- # compile
- set fname $projectdir:$item
- f2cCheck
- switchTo $MACF2C
- if {[f2cOneFile $fname]} return
- switchTo $ALPHA
- f2cAddOneFile $cname
- }
- }
-
-
- #-----------------------------------------------------------------------
- # f2cAddOneFile
- #-----------------------------------------------------------------------
- # add .c file to project and update menu
- # the file is added to segment 1, without specification of Segm,
- # each time a file is added, a new segment is build
- proc f2cAddOneFile {cname} {
- global projectFiles otherFiles CODEWarrior CWCLASS
- set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS AddF "----" [makeAlis $cname] Segm 1 ]
- regexp {:\[(.*)\]} $res dummy err
- if {! $err} {
- regsub {\.c$} $cname {.f} fname
- set blah [file tail $fname]
- addMenuItem -m projectFiles $blah
- deleteMenuItem -m otherFiles $blah
- lappend projectFiles $blah
- if {[set i [lsearch -exact $otherFiles "$blah"]] >= 0} {
- set otherFiles [lreplace $otherFiles $i $i]
- }
- }
- }
-
- #-----------------------------------------------------------------------
- # f2cRemoveOneFile
- #-----------------------------------------------------------------------
- proc f2cRemoveOneFile {cname} {
- global projectFiles otherFiles CODEWarrior CWCLASS
- set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS RemF "----" [makeAlis $cname]]
- regexp {:\[(.*)\]} $res dummy err
- if {! $err} {
- regsub {\.c$} $cname {.f} fname
- set blah [file tail $fname]
- deleteMenuItem -m projectFiles $blah
- addMenuItem -m otherFiles $blah
- lappend otherFiles $blah
- if {[set i [lsearch -exact $projectFiles "$blah"]] >= 0} {
- set projectFiles [lreplace $projectFiles $i $i]
- }
- }
- }
-
-
-
- #-----------------------------------------------------------------------
- # f2cRemoveFile: remove file in the front window from project
- #-----------------------------------------------------------------------
- proc f2cRemoveFile {} {
- global CODEWarrior CWCLASS projectdir f2cMenu projectFiles otherFiles
-
- # get name of current window
- set fname [lindex [winNames -f] 0]
-
- # return if not *.f
- if {[regexp {.f$} $fname] == 0} return
-
- # return if not in projectdir
- set blah [file tail $fname]
- set fname $projectdir:$blah
- if {[file exists $fname] != 1} return
-
- # return if *.c file not in projectdir
- regsub {\.f$} $fname {.c} cname
- if {[file exists $cname] != 1} return
-
- # ok, remove from project and update menu
- f2cRemoveOneFile $cname
- }
-
- #-----------------------------------------------------------------------
- # f2cRemoveFiles
- #-----------------------------------------------------------------------
- proc f2cRemoveFiles {} {
- global projectFiles otherFiles projectdir
- set name [listpick -l -L blah -p "Pick files to remove from project:" $projectFiles]
- foreach item $name {
- regsub {\.f$} $item {.c} citem
- set cname $projectdir:$citem
- f2cRemoveOneFile $cname
- }
- }
-
-
- #------------------------------------------------------------------------
- # f2cRun: f2c translate (if necessary), followed by CodeWarrior run
- #------------------------------------------------------------------------
- proc f2cRun {} {
- global ALPHA MACF2C f2cJobs
-
- saveAll
- if {$f2cJobs != ""} {
- # something to do for f2c
- f2cCheck
- switchTo $MACF2C
- foreach fname $f2cJobs {
- if {[f2cOneFile $fname]} return
- }
- }
- cwrun
- }
- #------------------------------------------------------------------------
- # f2cMake: f2c translate (if necessary), followed by CodeWarrior make
- #------------------------------------------------------------------------
- proc f2cMake {} {
- global ALPHA MACF2C f2cJobs
-
- saveAll
- if {$f2cJobs != ""} {
- # something to do for f2c
- f2cCheck
- switchTo $MACF2C
- foreach fname $f2cJobs {
- if {[f2cOneFile $fname]} return
- }
- }
- cwmake
- switchTo $ALPHA
- }
-
-
- #-----------------------------------------------------------------------
- # saveHook: modified by adding f2c support
- # each time a .f file is saved, its name is added to f2cJobs
- #-----------------------------------------------------------------------
- proc saveHook name {
- global backup backExtension backDir mode
-
- # f2c support added by kt
- global f2cJobs
- # get filename without path
- regexp {[^:]*$} $name item
- if {[regexp {.f$} $item]} {
- # is *.f
- if {[regexp $name $f2cJobs] == 0} {
- # not contained in f2cJobs, append
- lappend f2cJobs $name
- }
- }
- # end of added f2c support
-
- if ($backup) {
- if {![string length [set dir $backDir]]} {
- set dir [file dirname $name]
- }
- if {![file exists $dir]} {
- if {[askyesno "Create backup dir '$dir'?"] == "yes"} {
- mkdir $dir
- }
- }
- catch {rm $dir:[file tail $name]$backExtension}
- catch {cp $name $dir:[file tail $name]$backExtension}
- }
- }
-
- #-----------------------------------------------------------------------
- # f2cCheckCw: modified checkCw from codewarrior.tcl
- #-----------------------------------------------------------------------
- proc f2cCheckCw {} {
- global CODEWarrior modifiedVars cwSig cwPath
-
- # last parameter is default 1 = launch -f, 0 = launch
- set CODEWarrior [checkRunning "CodeWarrior IDE 1.3.1" $cwSig cwPath 0]
-
- set sig [getFileSig $cwPath]
- if {$sig != $cwSig} {
- lappend modifiedVars cwSig
- set cwSig $sig
- }
- }
-
-